home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1997 / HAM Radio 1997.iso / vcls / cltsvr / sockets.pas < prev    next >
Pascal/Delphi Source File  |  1996-04-08  |  46KB  |  1,308 lines
  1. unit Sockets;
  2. { Install this component using Options|Install Compenents.
  3.   The function of this module is to provide Delphi with a
  4.   component capable of performing TCP/IP Socket's functions
  5.   by interfacing with WINSOCK.DLL provided by many vendors
  6.   including Microsoft.
  7.  
  8.   The code herein is released to the public domain under the condition
  9.   that it will not be used for commercial or "For Profit" ventures.
  10.  
  11.   Written By:      Gary T. Desrosiers
  12.   Date:            March 27th, 1995.
  13.   Copyright:       (R) Copyright by Gary T. Desrosiers, 1995. All Rights Reserved
  14.   UserID(s):       71062,2754
  15.                    desrosi@pcnet.com
  16.  
  17.   Description:     This control performs WinSock TCP/IP functions.
  18.  
  19.   Prerequisites:   You will need a WinSock 1.1 compatable TCP/IP stacks
  20.                    to use this control. The control has been tested with
  21.                    Trumpet 2.1B, Chameleon 4.03, PC/TCP, and the native
  22.                    stacks in Windows NT and Windows 95.
  23.  
  24.   Modifications:   Version 2 - July 5th, 1995
  25.                    - Added properties;
  26.                      - MasterSocket, Gets the listener's socket
  27.                      - Peek, Preview data in the input buffer.
  28.                      - NonBlocking, Blocking vs Non-Blocking sockets
  29.                      - Timeout, For blocking mode timeouts
  30.                      - OOB, Sends and receives data out of band (urgent data)
  31.                    - Modified properties;
  32.                      - SocketNumber to read/write
  33.                      - Text (no longer published)
  34.                    - Added Methods;
  35.                      - SCancelListen, new method cancels the listener socket
  36.                      - GetPeerIPAddr, returns partners IP address
  37.                      - GetPeerPort, returns partners port
  38.                    - Modified Methods;
  39.                      - GetIPAddr, Documented and bug fix
  40.                      - GetPort, Documented
  41.                      - SClose, Added shutdown, etc.
  42.                      - SReceive, Modified to use PChar instead of Pascal strings
  43.                      - SSend, Modified to use PChar instead of Pascal strings
  44.                      - SetText, Now loops until entire buffer sent
  45.                    - Added Events
  46.                      - OnErrorOccurred, Called on WinSock errors.
  47.  
  48.   Properties:      IPAddr, Design time and runtime read/write.
  49.                      Sets the IP Address of the partner that you will
  50.                      eventually SConnect to. You may specify this as
  51.                      dotted decimal or a literal name to be converted
  52.                      via DNS.
  53.                      examples;
  54.                        Sockets1.IPAddr := 'desrosi';
  55.                        Sockets1.IPAddr := '127.0.0.1';
  56.                        addr := Sockets1.IPAddr;
  57.  
  58.                    Port, Design time and runtime read/write.
  59.                      Sets the Port number of the remote port to connect
  60.                      to or the local port to listen on depending on
  61.                      whether you subsequently issue a SConnect or SListen.
  62.                      This can be specified as a number or a literal name
  63.                      to be converted via DNS.
  64.                      examples;
  65.                        Sockets1.Port := 'echo';
  66.                        Sockets1.Port := '7';
  67.                        port := Sockets1.Port;
  68.  
  69.                    SocketNumber, Runtime Read/write.
  70.                      Returns (or sets) the socket number of the currently
  71.                      allocated connection.
  72.                      example;
  73.                        sock := Sockets1.SocketNumber;
  74.  
  75.                    MasterSocket, Runtime Read/Write.
  76.                      Returns (or sets) the master socket number (listener)
  77.                      example;
  78.                        msock := Sockets1.MasterSocket;
  79.  
  80.                    Text, Design time and runtime read/write.
  81.                      if set, sends the text to the partner.
  82.                      if read, receives some text from the partner.
  83.                      examples;
  84.                        buffer := Sockets1.Text; (* Receive data *)
  85.                        Sockets1.Text := 'This is a test'; (* Send Data *)
  86.  
  87.                    Peek, runtime read only.
  88.                      Returns up to 255 characters of data waiting to
  89.                      be received but does not actually receive the
  90.                      data.
  91.  
  92.                    OOB, runtime read/write.
  93.                      if set, sends the text to the partner as urgent (out of
  94.                        band) data.
  95.                      if read, receives urgent (out of band) data.
  96.                      examples;
  97.                        buffer := Sockets1.OOB;
  98.                        Sockets1.OOB := 'This is a test';
  99.  
  100.                    NonBlocking, Design time and runtime read/write
  101.                      Set to False for blocking mode and True for non-blocking
  102.                      mode (the default). When the socket is in blocking
  103.                      mode, none of the event callback functions (with the
  104.                      exception of OnErrorOccurred) will function.
  105.  
  106.                    Timeout, Design time and runtime read/write
  107.                      When NonBlocking = 0 (blocking mode) this value
  108.                      specifies the maximum amount of time that
  109.                      a socket operation can take. After this time
  110.                      limit expires, the operation is canceled and
  111.                      an error occurs. The default is 30 (seconds).
  112.                      The Valid range is 0-60 seconds. Setting Timeout
  113.                      to zero causes the operation to wait indefinitely.
  114.  
  115. Methods:           SConnect - Connects to the remote (or local) system
  116.                      specified in the IPAddr and Port properties.
  117.                      example;
  118.                        Sockets1.SConnect; (* Connect to partner *)
  119.  
  120.                    SListen - Listens on the port specified in the Port
  121.                      property.
  122.                      example;
  123.                        Sockets1.SListen; (* Establish server environment *)
  124.  
  125.                    SCancelListen - Cancels listens on the socket.
  126.                      example;
  127.                        Sockets1.SCancelListen; (* Dont accept further clients *)
  128.  
  129.                    SAccept - Accepts a client request. Usually issued in
  130.                      OnSessionAvailable event.
  131.                      example;
  132.                        Sock := Sockets1.SAccept; (* Get client connection *)
  133.  
  134.                    SClose - Closes the socket.
  135.                      example;
  136.                        Sockets1.SClose; (* Close connection *)
  137.  
  138.                    SReceive - Receives data from partner, similar to
  139.                      reading the property Text although this function
  140.                      uses PChar instead of Pascal strings.
  141.                      example;
  142.                        len := Sockets1.SReceive(Sockets1.SocketNumber,szBuffer,4096);
  143.  
  144.                    SSend - Sends data to the partner, similar to
  145.                      setting the property Text although this function
  146.                      uses PChar instead of Pascal strings.
  147.                      example;
  148.                        len := Sockets1.SSend(Sockets1.SocketNumber,szBuff,32000);
  149.  
  150.                    GetPort - Returns the actual port number of the socket
  151.                      specified as the argument. Generally used when you've
  152.                      specified a port of zero and need to retrieve the
  153.                      assigned port number.
  154.  
  155.                    GetIPAddr - Returns the IP Address of the socket specified
  156.                      as the argument.
  157.  
  158.                    GetPeerPort - Returns the partners port number of the socket
  159.                      specified as the argument.
  160.  
  161.                    GetPeerIPAddr - Returns partners IP Address of the socket
  162.                      specified as the argument.
  163.  
  164. Events:            OnDataAvailable - Called when data is available to
  165.                      be received from the partner. You should issue;
  166.                      buffer := Sockets1.Text; or a SReceive method to
  167.                      receive the data from the partner.
  168.  
  169.                    OnSessionAvailable - Called when a client has requested
  170.                      to connect to a 'listening' server. You can call
  171.                      the method SAccept here.
  172.  
  173.                    OnSessionClosed - Called when the partner has closed
  174.                      a socket on you. Normally, you would close your side
  175.                      of the socket when this event happens.
  176.  
  177.                    OnSessionConnected - Called when the SConnect has
  178.                      completed and the session is connected. This is a
  179.                      good place to send the initial data of a conversation.
  180.                      Also, you may want to enable certain controls that
  181.                      allow the user to send data on the conversation here.
  182.  
  183.                    OnErrorOccurred - Called when an error occurs on the socket.
  184.                      If defined, the OnErrorOccurred procedure is called when
  185.                      the error occurs. If the procedure isn't defined then
  186.                      a dialog box is displayed with the error text and the
  187.                      program is halted.
  188. }
  189. interface
  190.  
  191. uses
  192.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  193.   Forms, Dialogs;
  194. const
  195.   { Not all of these constants are used in this component, I included
  196.     the entire WinSock.h header file constants for completeness. }
  197.  
  198.   { User Windows Messages }
  199.   WM_ASYNCSELECT = WM_USER + 0;
  200.  
  201.   { Misc constants }
  202.   FD_SETSIZE = 64;
  203.   INADDR_ANY: longint = 0;
  204.   INADDR_NONE: longint = -1;
  205.   INADDR_LOOPBACK: longint = $7f000001; { IPAddr: 127.0.0.1 }
  206.   WSADESCRIPTION_LEN = 256;
  207.   WSASYS_STATUS_LEN = 128;
  208.  
  209.   { Protocols }
  210.   IPPROTO_IP         =  0;              { dummy for IP }
  211.   IPPROTO_ICMP       =  1;              { control message protocol }
  212.   IPPROTO_GGP        =  2;              { gateway^2 (deprecated) }
  213.   IPPROTO_TCP        =  6;              { tcp }
  214.   IPPROTO_PUP        =  12;             { pup }
  215.   IPPROTO_UDP        =  17;             { user datagram protocol }
  216.   IPPROTO_IDP        =  22;             { xns idp }
  217.   IPPROTO_ND         =  77;             { UNOFFICIAL net disk proto }
  218.   IPPROTO_RAW        = 255;             { raw IP packet }
  219.   IPPROTO_MAX        = 256;
  220.  
  221.   { Port/socket numbers: network standard functions }
  222.   IPPORT_ECHO        =     7;
  223.   IPPORT_DISCARD     =     9;
  224.   IPPORT_SYSTAT      =     11;
  225.   IPPORT_DAYTIME     =     13;
  226.   IPPORT_NETSTAT     =     15;
  227.   IPPORT_FTP         =     21;
  228.   IPPORT_TELNET      =     23;
  229.   IPPORT_SMTP        =     25;
  230.   IPPORT_TIMESERVER  =     37;
  231.   IPPORT_NAMESERVER  =     42;
  232.   IPPORT_WHOIS       =     43;
  233.   IPPORT_MTP         =     57;
  234.  
  235.   { Port/socket numbers: host specific functions }
  236.   IPPORT_TFTP        =     69;
  237.   IPPORT_RJE         =     77;
  238.   IPPORT_FINGER      =     79;
  239.   IPPORT_TTYLINK     =     87;
  240.   IPPORT_SUPDUP      =     95;
  241.  
  242.   { UNIX TCP sockets }
  243.   IPPORT_EXECSERVER  =     512;
  244.   IPPORT_LOGINSERVER =     513;
  245.   IPPORT_CMDSERVER   =     514;
  246.   IPPORT_EFSSERVER   =     520;
  247.  
  248.   { UNIX UDP sockets }
  249.   IPPORT_BIFFUDP     =     512;
  250.   IPPORT_WHOSERVER   =     513;
  251.   IPPORT_ROUTESERVER =     520;
  252.  
  253.   { Ports < IPPORT_RESERVED are reserved for privileged processes (e.g. root) }
  254.   IPPORT_RESERVED    =     1024;
  255.  
  256.   { Link numbers }
  257.   IMPLINK_IP         =     155;
  258.   IMPLINK_LOWEXPER   =     156;
  259.   IMPLINK_HIGHEXPER  =     158;
  260.  
  261.   INVALID_SOCKET     =     $ffff;
  262.   SOCKET_ERROR       =     (-1);
  263.  
  264.   { Types }
  265.   SOCK_STREAM        =  1;              { stream socket }
  266.   SOCK_DGRAM         =  2;              { datagram socket }
  267.   SOCK_RAW           =  3;              { raw-protocol interface }
  268.   SOCK_RDM           =  4;              { reliably-delivered message }
  269.   SOCK_SEQPACKET     =  5;              { sequenced packet stream }
  270.  
  271.   { Option flags per-socket }
  272.   SO_DEBUG           =  $0001;         { turn on debugging info recording }
  273.   SO_ACCEPTCONN      =  $0002;         { socket has had listen() }
  274.   SO_REUSEADDR       =  $0004;         { allow local address reuse }
  275.   SO_KEEPALIVE       =  $0008;         { keep connections alive }
  276.   SO_DONTROUTE       =  $0010;         { just use interface addresses }
  277.   SO_BROADCAST       =  $0020;         { permit sending of broadcast msgs }
  278.   SO_USELOOPBACK     =  $0040;         { bypass hardware when possible }
  279.   SO_LINGER          =  $0080;         { linger on close if data present }
  280.   SO_OOBINLINE       =  $0100;         { leave received OOB data in line }
  281.   SO_DONTLINGER      = (not SO_LINGER);
  282.  
  283.  { Additional options }
  284.   SO_SNDBUF          =  $1001;         { send buffer size }
  285.   SO_RCVBUF          =  $1002;         { receive buffer size }
  286.   SO_SNDLOWAT        =  $1003;         { send low-water mark }
  287.   SO_RCVLOWAT        =  $1004;         { receive low-water mark }
  288.   SO_SNDTIMEO        =  $1005;         { send timeout }
  289.   SO_RCVTIMEO        =  $1006;         { receive timeout }
  290.   SO_ERROR           =  $1007;         { get error status and clear }
  291.   SO_TYPE            =  $1008;         { get socket type }
  292.  
  293.  
  294.   { TCP options }
  295.   TCP_NODELAY        =  $0001;
  296.  
  297.   { Address families }
  298.   AF_UNSPEC          =  0;              { unspecified }
  299.   AF_UNIX            =  1;              { local to host (pipes, portals) }
  300.   AF_INET            =  2;              { internetwork: UDP, TCP, etc. }
  301.   AF_IMPLINK         =  3;              { arpanet imp addresses }
  302.   AF_PUP             =  4;              { pup protocols: e.g. BSP }
  303.   AF_CHAOS           =  5;              { mit CHAOS protocols }
  304.   AF_NS              =  6;              { XEROX NS protocols }
  305.   AF_ISO             =  7;               { ISO protocols }
  306.   AF_OSI             =  AF_ISO;         { OSI is ISO }
  307.   AF_ECMA            =  8;              { european computer manufacturers }
  308.   AF_DATAKIT         =  9;              { datakit protocols }
  309.   AF_CCITT           =  10;             { CCITT protocols, X.25 etc }
  310.   AF_SNA             =  11;             { IBM SNA }
  311.   AF_DECnet          =  12;             { DECnet }
  312.   AF_DLI             =  13;             { Direct data link interface }
  313.   AF_LAT             =  14;             { LAT }
  314.   AF_HYLINK          =  15;             { NSC Hyperchannel }
  315.   AF_APPLETALK       =  16;             { AppleTalk }
  316.   AF_NETBIOS         =  17;             { NetBios-style addresses }
  317.   AF_MAX             =  18;
  318.  
  319.   { Protocol families, same as address families for now }
  320.   PF_UNSPEC          =  AF_UNSPEC;
  321.   PF_UNIX            =  AF_UNIX;
  322.   PF_INET            =  AF_INET;
  323.   PF_IMPLINK         =  AF_IMPLINK;
  324.   PF_PUP             =  AF_PUP;
  325.   PF_CHAOS           =  AF_CHAOS;
  326.   PF_NS              =  AF_NS;
  327.   PF_ISO             =  AF_ISO;
  328.   PF_OSI             =  AF_OSI;
  329.   PF_ECMA            =  AF_ECMA;
  330.   PF_DATAKIT         =  AF_DATAKIT;
  331.   PF_CCITT           =  AF_CCITT;
  332.   PF_SNA             =  AF_SNA;
  333.   PF_DECnet          =  AF_DECnet;
  334.   PF_DLI             =  AF_DLI;
  335.   PF_LAT             =  AF_LAT;
  336.   PF_HYLINK          =  AF_HYLINK;
  337.   PF_APPLETALK       =  AF_APPLETALK;
  338.   PF_MAX             =  AF_MAX;
  339.  
  340.  { Level number for (get/set)sockopt() to apply to socket itself }
  341.  SOL_SOCKET          = -1;          { options for socket level }
  342.  
  343.  { Maximum queue length specifiable by listen }
  344.  SOMAXCONN     =   5;
  345.  
  346.  MSG_OOB       =  $1;             { process out-of-band data }
  347.  MSG_PEEK      =  $2;             { peek at incoming message }
  348.  MSG_DONTROUTE =  $4;             { send without using routing tables }
  349.  
  350.  MSG_MAXIOVLEN =  16;
  351.  
  352.  { Define constant based on rfc883, used by gethostbyxxxx() calls }
  353.  MAXGETHOSTSTRUCT   =     1024;
  354.  
  355.  { Define flags to be used with the WSAAsyncSelect() call }
  356.  FD_READ       =  $01;
  357.  FD_WRITE      =  $02;
  358.  FD_OOB        =  $04;
  359.  FD_ACCEPT     =  $08;
  360.  FD_CONNECT    =  $10;
  361.  FD_CLOSE      =  $20;
  362.  
  363.  { All Windows Sockets error constants are biased by WSABASEERR fromthe normal }
  364.  WSABASEERR    =          10000;
  365.  
  366.  { Windows Sockets definitions of regular Microsoft C error constants }
  367.  WSAEINTR      =          (WSABASEERR+4);
  368.  WSAEBADF      =          (WSABASEERR+9);
  369.  WSAEACCES     =          (WSABASEERR+13);
  370.  WSAEFAULT     =          (WSABASEERR+14);
  371.  WSAEINVAL     =          (WSABASEERR+22);
  372.  WSAEMFILE     =          (WSABASEERR+24);
  373.  
  374.  { Windows Sockets definitions of regular Berkeley error constants }
  375.  WSAEWOULDBLOCK      =    (WSABASEERR+35);
  376.  WSAEINPROGRESS      =    (WSABASEERR+36);
  377.  WSAEALREADY         =    (WSABASEERR+37);
  378.  WSAENOTSOCK         =    (WSABASEERR+38);
  379.  WSAEDESTADDRREQ     =    (WSABASEERR+39);
  380.  WSAEMSGSIZE         =    (WSABASEERR+40);
  381.  WSAEPROTOTYPE       =    (WSABASEERR+41);
  382.  WSAENOPROTOOPT      =    (WSABASEERR+42);
  383.  WSAEPROTONOSUPPORT  =    (WSABASEERR+43);
  384.  WSAESOCKTNOSUPPORT  =    (WSABASEERR+44);
  385.  WSAEOPNOTSUPP       =    (WSABASEERR+45);
  386.  WSAEPFNOSUPPORT     =    (WSABASEERR+46);
  387.  WSAEAFNOSUPPORT     =    (WSABASEERR+47);
  388.  WSAEADDRINUSE       =    (WSABASEERR+48);
  389.  WSAEADDRNOTAVAIL    =    (WSABASEERR+49);
  390.  WSAENETDOWN         =    (WSABASEERR+50);
  391.  WSAENETUNREACH      =    (WSABASEERR+51);
  392.  WSAENETRESET        =    (WSABASEERR+52);
  393.  WSAECONNABORTED     =    (WSABASEERR+53);
  394.  WSAECONNRESET       =    (WSABASEERR+54);
  395.  WSAENOBUFS          =    (WSABASEERR+55);
  396.  WSAEISCONN          =    (WSABASEERR+56);
  397.  WSAENOTCONN         =    (WSABASEERR+57);
  398.  WSAESHUTDOWN        =    (WSABASEERR+58);
  399.  WSAETOOMANYREFS     =    (WSABASEERR+59);
  400.  WSAETIMEDOUT        =    (WSABASEERR+60);
  401.  WSAECONNREFUSED     =    (WSABASEERR+61);
  402.  WSAELOOP            =    (WSABASEERR+62);
  403.  WSAENAMETOOLONG     =    (WSABASEERR+63);
  404.  WSAEHOSTDOWN        =    (WSABASEERR+64);
  405.  WSAEHOSTUNREACH     =    (WSABASEERR+65);
  406.  WSAENOTEMPTY        =    (WSABASEERR+66);
  407.  WSAEPROCLIM         =    (WSABASEERR+67);
  408.  WSAEUSERS           =    (WSABASEERR+68);
  409.  WSAEDQUOT           =    (WSABASEERR+69);
  410.  WSAESTALE           =    (WSABASEERR+70);
  411.  WSAEREMOTE          =    (WSABASEERR+71);
  412.  
  413.  { Extended Windows Sockets error constant definitions }
  414.  WSASYSNOTREADY      =    (WSABASEERR+91);
  415.  WSAVERNOTSUPPORTED  =    (WSABASEERR+92);
  416.  WSANOTINITIALISED   =    (WSABASEERR+93);
  417.  
  418.  { Authoritative Answer: Host not found }
  419.  WSAHOST_NOT_FOUND   =    (WSABASEERR+1001);
  420.  HOST_NOT_FOUND      =    WSAHOST_NOT_FOUND;
  421.  
  422. { Non-Authoritative: Host not found, or SERVERFAIL }
  423.  WSATRY_AGAIN        =    (WSABASEERR+1002);
  424.  TRY_AGAIN           =    WSATRY_AGAIN;
  425.  
  426. { Non recoverable errors, FORMERR, REFUSED, NOTIMP }
  427.  WSANO_RECOVERY      =    (WSABASEERR+1003);
  428.  NO_RECOVERY         =    WSANO_RECOVERY;
  429.  
  430. { Valid name, no data record of requested type }
  431.  WSANO_DATA          =    (WSABASEERR+1004);
  432.  NO_DATA             =    WSANO_DATA;
  433.  
  434. { no address, look for MX record }
  435.  WSANO_ADDRESS       =    WSANO_DATA;
  436.  NO_ADDRESS          =    WSANO_ADDRESS;
  437.  
  438. { Windows Sockets errors redefined as regular Berkeley error constants }
  439.  EWOULDBLOCK         =    WSAEWOULDBLOCK;
  440.  EINPROGRESS         =    WSAEINPROGRESS;
  441.  EALREADY            =    WSAEALREADY;
  442.  ENOTSOCK            =    WSAENOTSOCK;
  443.  EDESTADDRREQ        =    WSAEDESTADDRREQ;
  444.  EMSGSIZE            =    WSAEMSGSIZE;
  445.  EPROTOTYPE          =    WSAEPROTOTYPE;
  446.  ENOPROTOOPT         =    WSAENOPROTOOPT;
  447.  EPROTONOSUPPORT     =    WSAEPROTONOSUPPORT;
  448.  ESOCKTNOSUPPORT     =    WSAESOCKTNOSUPPORT;
  449.  EOPNOTSUPP          =    WSAEOPNOTSUPP;
  450.  EPFNOSUPPORT        =    WSAEPFNOSUPPORT;
  451.  EAFNOSUPPORT        =    WSAEAFNOSUPPORT;
  452.  EADDRINUSE          =    WSAEADDRINUSE;
  453.  EADDRNOTAVAIL       =    WSAEADDRNOTAVAIL;
  454.  ENETDOWN            =    WSAENETDOWN;
  455.  ENETUNREACH         =    WSAENETUNREACH;
  456.  ENETRESET           =    WSAENETRESET;
  457.  ECONNABORTED        =    WSAECONNABORTED;
  458.  ECONNRESET          =    WSAECONNRESET;
  459.  ENOBUFS             =    WSAENOBUFS;
  460.  EISCONN             =    WSAEISCONN;
  461.  ENOTCONN            =    WSAENOTCONN;
  462.  ESHUTDOWN           =    WSAESHUTDOWN;
  463.  ETOOMANYREFS        =    WSAETOOMANYREFS;
  464.  ETIMEDOUT           =    WSAETIMEDOUT;
  465.  ECONNREFUSED        =    WSAECONNREFUSED;
  466.  ELOOP               =    WSAELOOP;
  467.  ENAMETOOLONG        =    WSAENAMETOOLONG;
  468.  EHOSTDOWN           =    WSAEHOSTDOWN;
  469.  EHOSTUNREACH        =    WSAEHOSTUNREACH;
  470.  ENOTEMPTY           =    WSAENOTEMPTY;
  471.  EPROCLIM            =    WSAEPROCLIM;
  472.  EUSERS              =    WSAEUSERS;
  473.  EDQUOT              =    WSAEDQUOT;
  474.  ESTALE              =    WSAESTALE;
  475.  EREMOTE             =    WSAEREMOTE;
  476.  
  477.  FIONBIO             =    $8004667E;
  478.  FIONREAD            =    $4004667F;
  479.  
  480. type
  481.   u_char = byte;
  482.   u_short = word;
  483.   u_int = word;
  484.   u_long = longint;
  485.   TSocket = u_int;
  486.   servent = record
  487.     s_name: PChar;
  488.     s_aliases: ^PChar;
  489.     s_port: integer;
  490.     s_proto: PChar;
  491.   end;
  492.   Pservent = ^servent;
  493.  
  494.   Protoent = record
  495.     p_name: PChar;
  496.     p_aliases: ^PChar;
  497.     p_proto: integer;
  498.   end;
  499.   Pprotoent = ^protoent;
  500.  
  501.   { some liberties taken with this structure }
  502.   in_addr = record
  503.     Case integer of
  504.     0: (s_net, s_host, s_lh, s_impno: u_char);
  505.     1: (s_w1,s_imp: u_short);
  506.     2: (s_addr: u_long);
  507.   end;
  508.   Pin_addr = ^in_addr;
  509.  
  510.   sockaddr_in = record
  511.     sin_family: integer;
  512.     sin_port: u_short;
  513.     sin_addr: in_addr;
  514.     sin_zero: array[0..7] of char;
  515.   end;
  516.   Psockaddr_in = ^sockaddr_in;
  517.  
  518.   hostent = record
  519.     h_name: PChar;
  520.     h_aliases: ^PChar;
  521.     h_addrtype: word;
  522.     h_length: word;
  523.     Case integer of
  524.     0: (h_addr_list: ^PChar);
  525.     1: (h_addr: ^pin_addr);
  526.   end;
  527.   Phostent = ^hostent;
  528.  
  529.   WSADATA = record
  530.     wVersion: word;
  531.     wHighVersion: word;
  532.     szDescription: array[0..WSADESCRIPTION_LEN] of char;
  533.     szSystemStatus: array[0..WSASYS_STATUS_LEN] of char;
  534.     iMaxSockets: u_short;
  535.     iMaxUdpDg: u_short;
  536.     lpVendorInfo: PChar;
  537.   end;
  538.  
  539.   sockaddr = record
  540.     sa_family: u_short;
  541.     sa_data: array[0..13] of char;
  542.   end;
  543.  
  544.   sockproto = record
  545.     sp_family: u_short;
  546.     sp_protocol: u_short;
  547.   end;
  548.  
  549.   linger = record
  550.     l_onoff: u_short;
  551.     l_linger: u_short;
  552.   end;
  553.  
  554.   TDataAvailable = procedure (Sender: TObject; Socket: TSocket) of object;
  555.   TSessionClosed = procedure (Sender: TObject; Socket: TSocket) of object;
  556.   TSessionAvailable = procedure (Sender: TObject; Socket: TSocket) of object;
  557.   TSessionConnected = procedure (Sender: TObject; Socket: TSocket) of object;
  558.   TErrorOccurred = procedure (Sender: TObject; Error: integer; Msg: string) of object;
  559.  
  560.   TSockets = class(TWinControl)
  561.   private
  562.     Pse: Pservent;
  563.     Phe: Phostent;
  564.     Ppe: Pprotoent;
  565.     sin: sockaddr_in;
  566.     initdata: WSADATA;
  567.     FPort: String;
  568.     FIPAddr: String;
  569.     FSocket: TSocket;
  570.     FMSocket: TSocket;
  571.     FMode: longint;
  572.     FTimeout: integer;
  573.     FDataAvailable: TDataAvailable;
  574.     FSessionClosed: TSessionClosed;
  575.     FSessionAvailable: TSessionAvailable;
  576.     FSessionConnected: TSessionConnected;
  577.     FErrorOccurred: TErrorOccurred;
  578.     procedure SetText(Text: string);
  579.     function GetText : string;
  580.     procedure SetTextOOB(Text: string);
  581.     function GetTextOOB : string;
  582.     function PeekData : string;
  583.     function SocketErrorDesc(error: integer) : string;
  584.     procedure SocketError(sockfunc: string);
  585.     procedure TWMPaint(var msg:TWMPaint); message WM_PAINT;
  586.     procedure SetTimeout;
  587.     procedure ResetTimeout;
  588.   protected
  589.     procedure WMASyncSelect(var msg: TMessage); message WM_ASYNCSELECT;
  590.     procedure WMTimer(var msg: TMessage); message WM_TIMER;
  591.   public
  592.     constructor Create(AOwner: TComponent); override;
  593.     destructor Destroy; override;
  594.     { I'd like to call these methods Connect, Close, Listen, etc but
  595.       they would conflict with the WinSock.DLL function names ! }
  596.     procedure SConnect;
  597.     procedure SClose;
  598.     procedure SListen;
  599.     procedure SCancelListen;
  600.     function SAccept: TSocket;
  601.     function SReceive(aSocket: TSocket; szBuff: PChar; var rlen: integer): integer;
  602.     function SSend(aSocket: TSocket;szBuff: PChar; var slen: integer): integer;
  603.     function GetIPAddr(aSocket: TSocket): string;
  604.     function GetPort(aSocket: TSocket): string;
  605.     function GetPeerIPAddr(aSocket: TSocket): string;
  606.     function GetPeerPort(aSocket: TSocket): string;
  607.     function GetBlocking: Boolean;
  608.     procedure SetBlocking(flag: Boolean);
  609.     property Text: string read GetText write SetText;
  610.     property Peek: string read PeekData;
  611.     property OOB: string read GetTextOOB write SetTextOOB;
  612.     property SocketNumber: TSocket read FSocket write FSocket;
  613.     property MasterSocket: TSocket read FMSocket write FMSocket;
  614.   published
  615.     property IPAddr: string read FIPAddr write FIPAddr;
  616.     property Port: string read FPort write FPort;
  617.     property NonBlocking: Boolean read GetBlocking write SetBlocking default True;
  618.     property Timeout: integer read FTimeout write FTimeout default 30;
  619.     property OnDataAvailable: TDataAvailable read FDataAvailable
  620.       write FDataAvailable;
  621.     property OnSessionClosed: TSessionClosed read FSessionClosed
  622.       write FSessionClosed;
  623.     property OnSessionAvailable: TSessionAvailable read FSessionAvailable
  624.       write FSessionAvailable;
  625.     property OnSessionConnected: TSessionConnected read FSessionConnected
  626.       write FSessionConnected;
  627.     property OnErrorOccurred: TErrorOccurred read FErrorOccurred
  628.       write FErrorOccurred;
  629.   end;
  630.  
  631. procedure Register;
  632.  
  633. implementation
  634.  
  635. { Function declarations for window's sockets (winsock)  This is a complete
  636.   set of function declarations for winsock, not all functions are called
  637.   from this component. }
  638. function accept(s: TSocket; var addr: sockaddr_in; var addrlen: integer) : TSocket;
  639.   far; external 'WINSOCK';
  640. function bind(s: TSocket; var addr: sockaddr_in; namelen: integer) : integer;
  641.   far; external 'WINSOCK';
  642. function closesocket(s: TSocket) : integer;
  643.   far; external 'WINSOCK';
  644. function connect(s: TSocket; var name: sockaddr_in; namelen: integer) : integer;
  645.   far; external 'WINSOCK';
  646. function ioctlsocket(s: TSocket; cmd: longint; var argp: longint) : integer;
  647.   far; external 'WINSOCK';
  648. function getpeername(s: TSocket; var name: sockaddr_in; var namelen: integer) :
  649.   integer; far; external 'WINSOCK';
  650. function getsockname(s: TSocket; var name: sockaddr_in; var namelen: integer) :
  651.   integer; far; external 'WINSOCK';
  652. function getsockopt(s: TSocket; level: integer; optname: integer;
  653.   optval: PChar; var optlen: integer) : integer; far; external 'WINSOCK';
  654. function htonl(hostlong: u_long) : u_long; far; external 'WINSOCK';
  655. function htons(hostshort: u_short) : u_short; far; external 'WINSOCK';
  656. function inet_addr(cp: PChar) : u_long; far; external 'WINSOCK';
  657. function inet_ntoa(sin: in_addr) : PChar; far; external 'WINSOCK';
  658. function listen(s: TSocket; backlog: integer) : integer;
  659.   far; external 'WINSOCK';
  660. function ntohl(netlong: u_long) : u_long; far; external 'WINSOCK';
  661. function ntohs(netshort: u_short) : u_short; far; external 'WINSOCK';
  662. function recv(s: TSocket; buf: PChar; len: integer; flags: integer) : integer;
  663.   far; external 'WINSOCK';
  664. function recvfrom(s: TSocket; buf: PChar; len: integer; flags: integer;
  665.   var from: sockaddr_in; var fromlen: integer) : integer; far; external 'WINSOCK';
  666. function send(s: TSocket; buf: PChar; len: integer; flags: integer) : integer;
  667.   far; external 'WINSOCK';
  668. function sendto(s: TSocket; buf: PChar; len: integer; flags: integer;
  669.   var saddrto: sockaddr_in; tolen: integer) : integer; far; external 'WINSOCK';
  670. function setsockopt(s: TSocket; level: integer; optname: integer; optval: PChar;
  671.   optlen: integer) : integer; far; external 'WINSOCK';
  672. function shutdown(s: TSocket; how: integer) : integer; far; external 'WINSOCK';
  673. function socket(af: integer; stype: integer; protocol: integer) : TSocket;
  674.   far; external 'WINSOCK';
  675. function gethostbyaddr(addr: PChar; len: integer; stype: integer) : phostent;
  676.   far; external 'WINSOCK';
  677. function gethostbyname(name: PChar) :  phostent; far; external 'WINSOCK';
  678. function gethostname(name: PChar) : integer; far; external 'WINSOCK';
  679. function getservbyport(port: integer; proto: PChar) : pservent;
  680.   far; external 'WINSOCK';
  681. function getservbyname(name: PChar; proto: PChar) : pservent;
  682.   far; external 'WINSOCK';
  683. function getprotobynumber(proto: integer) : pprotoent; far; external 'WINSOCK';
  684. function getprotobyname(name: PChar) : pprotoent; far; external 'WINSOCK';
  685. { Winsock extensions to Berkeley Sockets }
  686. function WSAStartup(wVersionRequired: word; var lpWSAData: WSADATA) : integer;
  687.   far; external 'WINSOCK';
  688. function WSACleanup : integer; far; external 'WINSOCK';
  689. procedure WSASetLastError(iError: integer); far; external 'WINSOCK';
  690. function WSAGetLastError : integer; far; external 'WINSOCK';
  691. function WSAIsBlocking : Boolean; far; external 'WINSOCK';
  692. function WSASetBlockingHook : integer; far; external 'WINSOCK';
  693. function WSACancelBlockingCall : integer; far; external 'WINSOCK';
  694. function WSAAsyncGetServByName(handle: HWND; wMsg: u_int; name: pChar;
  695.   proto: PChar; buf: PChar; buflen: integer) : THandle; far; external 'WINSOCK';
  696. function WSAAsyncGetServByPort(handle: HWND; wMsg: u_int; port: integer;
  697.   proto: PChar; buf: PChar; buflen: integer) : THandle; far; external 'WINSOCK';
  698. function WSAAsyncGetProtoByName(handle: HWND; wMsg: u_int; name: PChar;
  699.   buf: PChar; buflen: integer) : THandle; far; external 'WINSOCK';
  700. function WSAAsyncGetProtoByNumber(handle: HWND; wMsg: u_int; number: integer;
  701.   buf: PChar; buflen: integer) : THandle; far; external 'WINSOCK';
  702. function WSAAsyncGetHostByName(handle: HWND; wMsg: u_int; name: PChar;
  703.   buf: PChar; buflen: integer) : THandle; far; external 'WINSOCK';
  704. function WSAAsyncGetHostByAddr(handle: HWND; wMsg: u_int; addr: PChar;
  705.   len: integer; atype: integer; buf: PChar; buflen: integer) : THandle;
  706.   far; external 'WINSOCK';
  707. function WSACancelAsyncRequest(handle: THandle) :THandle;
  708.   far; external 'WINSOCK';
  709. function WSAAsyncSelect(s: TSocket; handle: HWND; wMsg: u_int; lEvent: longint)
  710.   : integer; far; external 'WINSOCK';
  711.  
  712. procedure Register;
  713. begin
  714.   RegisterComponents('Samples', [TSockets]);
  715. end;
  716.  
  717.  
  718. constructor TSockets.Create(AOwner: TComponent);
  719. var
  720.   iStatus: integer;
  721. begin
  722.   inherited Create(AOwner);
  723.   FMode := 1;
  724.   FTimeout := 30;
  725.   FSocket := INVALID_SOCKET;
  726.   FMSocket := INVALID_SOCKET;
  727.   iStatus := WSAStartup($101,initdata);
  728.   if iStatus <> 0 then
  729.     SocketError('Constructor (WSAStartup)');
  730.   Invalidate;
  731. end;
  732.  
  733. destructor TSockets.Destroy;
  734. var
  735.   iStatus: integer;
  736. begin
  737.   iStatus := WSACleanup;
  738.   if iStatus < 0 then
  739.     SocketError('Destructor (WSACleanup)');
  740.   inherited Destroy;
  741. end;
  742.  
  743. procedure TSockets.TWMPaint(var msg: TWMPaint);
  744. var
  745.   icon: HIcon;
  746.   dc: HDC;
  747. begin
  748.   if csDesigning in ComponentState then
  749.   begin
  750.     icon := LoadIcon(HInstance,MAKEINTRESOURCE('TSOCKETS'));
  751.     dc := GetDC(Handle);
  752.     Width := 32;
  753.     Height := 32;
  754.     DrawIcon(dc,0,0,icon);
  755.     ReleaseDC(Handle,dc);
  756.     FreeResource(icon);
  757.   end;
  758.   ValidateRect(Handle,nil);
  759. end;
  760.  
  761. function TSockets.GetBlocking: Boolean;
  762. begin
  763.   if FMode = 1 then
  764.     Result := True
  765.   else
  766.     Result := False;
  767. end;
  768.  
  769. procedure TSockets.SetBlocking(flag: Boolean);
  770. begin
  771.   if flag then
  772.     FMode := 1
  773.   else
  774.     FMode := 0;
  775. end;
  776.  
  777. procedure TSockets.SetText(Text: string);
  778. var
  779.   BytesLeft, BytesSent: integer;
  780.   szBigBuff: array[0..256] of char;
  781.   pBuf: PChar;
  782. begin
  783.   StrPCopy(szBigBuff,Text);
  784.   pBuf := @szBigBuff[0];
  785.   BytesLeft := Length(Text);
  786.   while BytesLeft > 0 do
  787.   begin
  788.     if FMode = 0 then
  789.       SetTimeout;
  790.     BytesSent := send(FSocket,pBuf,BytesLeft,0);
  791.     if FMode = 0 then
  792.       ResetTimeout;
  793.     if BytesSent < 0 then
  794.       SocketError('SetText (Send)');
  795.     BytesLeft := BytesLeft - BytesSent;
  796.     pBuf := pBuf + BytesSent;
  797.   end;
  798. end;
  799.  
  800. function TSockets.GetText: string;
  801. var
  802.   len: integer;
  803.   BigBuff: string;
  804.   szBigBuff: array[0..256] of char absolute BigBuff;
  805. begin
  806.   if FSocket <> INVALID_SOCKET then
  807.   begin
  808.     if FMode = 0 then
  809.       SetTimeout;
  810.     len := recv(FSocket,@szBigBuff[1],255,0);
  811.     if FMode = 0 then
  812.       ResetTimeout;
  813.     if len < 0 then
  814.       SocketError('GetText (Recv)');
  815.     szBigBuff[0] := chr(len);
  816.     Result := BigBuff;
  817.   end
  818.   else Result := '';
  819. end;
  820.  
  821. procedure TSockets.SetTextOOB(Text: string);
  822. var
  823.   BytesLeft, BytesSent: integer;
  824.   szBigBuff: array[0..256] of char;
  825.   pBuf: PChar;
  826. begin
  827.   StrPCopy(szBigBuff,Text);
  828.   pBuf := @szBigBuff[0];
  829.   BytesLeft := Length(Text);
  830.   while BytesLeft > 0 do
  831.   begin
  832.     if FMode = 0 then
  833.       SetTimeout;
  834.     BytesSent := send(FSocket,pBuf,BytesLeft,MSG_OOB);
  835.     if FMode = 0 then
  836.       ResetTimeout;
  837.     if BytesSent < 0 then
  838.       SocketError('SetText (Send)');
  839.     BytesLeft := BytesLeft - BytesSent;
  840.     pBuf := pBuf + BytesSent;
  841.   end;
  842. end;
  843.  
  844. function TSockets.GetTextOOB: string;
  845. var
  846.   len: integer;
  847.   BigBuff: string;
  848.   szBigBuff: array[0..256] of char absolute BigBuff;
  849. begin
  850.   if FSocket <> INVALID_SOCKET then
  851.   begin
  852.     if FMode = 0 then
  853.       SetTimeout;
  854.     len := recv(FSocket,@szBigBuff[1],255,MSG_OOB);
  855.     if FMode = 0 then
  856.       ResetTimeout;
  857.     if len < 0 then
  858.       SocketError('GetText (Recv)');
  859.     szBigBuff[0] := chr(len);
  860.     Result := BigBuff;
  861.   end
  862.   else Result := '';
  863. end;
  864.  
  865.  
  866. function TSockets.PeekData: string;
  867. var
  868.   len: integer;
  869.   BigBuff: string;
  870.   szBigBuff: array[0..256] of char absolute BigBuff;
  871. begin
  872.   if FSocket <> INVALID_SOCKET then
  873.   begin
  874.     if FMode = 0 then
  875.       SetTimeout;
  876.     len := recv(FSocket,@szBigBuff[1],255,MSG_PEEK);
  877.     if FMode = 0 then
  878.       ResetTimeout;
  879.     if len < 0 then
  880.       SocketError('PeekData (Peek)');
  881.     szBigBuff[0] := chr(len);
  882.     Result := BigBuff;
  883.   end
  884.   else Result := '';
  885. end;
  886.  
  887. function TSockets.GetPort(aSocket: TSocket): string;
  888. var
  889.   addr: sockaddr_in;
  890.   addrlen: integer;
  891. begin
  892.   addrlen := sizeof(addr);
  893.   getsockname(aSocket,addr,addrlen);
  894.   Result := IntToStr(ntohs(addr.sin_port));
  895. end;
  896.  
  897. function TSockets.GetIPAddr(aSocket: TSocket): string;
  898. var
  899.   addr: sockaddr_in;
  900.   addrlen: integer;
  901.   szIPAddr: PChar;
  902. begin
  903.   addrlen := sizeof(addr);
  904.   getsockname(aSocket,addr,addrlen);
  905.   szIPAddr := inet_ntoa(addr.sin_addr);
  906.   Result := StrPas(szIPAddr);
  907. end;
  908.  
  909. function TSockets.GetPeerPort(aSocket: TSocket): string;
  910. var
  911.   addr: sockaddr_in;
  912.   addrlen: integer;
  913. begin
  914.   addrlen := sizeof(addr);
  915.   getpeername(aSocket,addr,addrlen);
  916.   Result := IntToStr(ntohs(addr.sin_port));
  917. end;
  918.  
  919. function TSockets.GetPeerIPAddr(aSocket: TSocket): string;
  920. var
  921.   addr: sockaddr_in;
  922.   addrlen: integer;
  923.   szIPAddr: PChar;
  924. begin
  925.   addrlen := sizeof(addr);
  926.   getpeername(aSocket,addr,addrlen);
  927.   szIPAddr := inet_ntoa(addr.sin_addr);
  928.   Result := StrPas(szIPAddr);
  929. end;
  930.  
  931.  
  932. function TSockets.SReceive(aSocket: TSocket; szBuff: PChar; var rlen: integer) : integer;
  933. begin
  934.   if FSocket <> INVALID_SOCKET then
  935.   begin
  936.     if FMode = 0 then
  937.       SetTimeout;
  938.     Result := recv(aSocket,szBuff,rlen,0);
  939.     if FMode = 0 then
  940.       ResetTimeout;
  941.     if rlen < 0 then
  942.       SocketError('SReceive');
  943.   end
  944.   else Result := -1;
  945. end;
  946.  
  947. function TSockets.SSend(aSocket: TSocket; szBuff: PChar; var slen: integer): integer;
  948. begin
  949.   if FMode = 0 then
  950.     SetTimeout;
  951.   slen := send(aSocket,szBuff,slen,0);
  952.   if FMode = 0 then
  953.     ResetTimeout;
  954.   if slen < 0 then
  955.     SocketError('SSend');
  956.   Result := slen;
  957. end;
  958.  
  959. procedure TSockets.WMASyncSelect(var msg: TMessage);
  960. begin
  961.   case LoWord(msg.lParam) of
  962.     FD_READ:
  963.     begin
  964.       if Assigned(FDataAvailable) then
  965.         FDataAvailable(Self,msg.wParam);
  966.     end;
  967.     FD_CLOSE:
  968.     begin
  969.       if Assigned(FSessionClosed) then
  970.         FSessionClosed(Self,msg.wParam);
  971.     end;
  972.     FD_ACCEPT:
  973.     begin
  974.       if Assigned(FSessionAvailable) then
  975.         FSessionAvailable(Self,msg.wParam);
  976.     end;
  977.     FD_CONNECT:
  978.     begin
  979.       if Assigned(FSessionConnected) then
  980.         FSessionConnected(Self,msg.wParam);
  981.     end;
  982.   end;
  983. end;
  984.  
  985. procedure TSockets.WMTimer(var msg: TMessage);
  986. var
  987.   szErrMsg: array[0..255] of char;
  988. begin
  989.   KillTimer(Handle,10);
  990.   if WSAIsBlocking then
  991.   begin
  992.     WSACancelBlockingCall;
  993.     if Assigned(FErrorOccurred) then
  994.       FErrorOccurred(Self,WSAETIMEDOUT,'Blocking call timed out')
  995.     else
  996.       begin
  997.         StrPCopy(szErrMsg,'Error ' + IntToStr(WSAETIMEDOUT) + #13#10 +
  998.           'Blocking call timed out');
  999.         Application.MessageBox(szErrMsg, 'WINSOCK CALL CANCELED', mb_OKCancel +
  1000.           mb_DefButton1);
  1001.       end;
  1002.   end;
  1003. end;
  1004.  
  1005.  
  1006. procedure TSockets.SConnect;
  1007. var
  1008.   iStatus: integer;
  1009.   szTcp: PChar;
  1010.   szPort: array[0..31] of char;
  1011.   szData: array[0..256] of char;
  1012. begin
  1013.   if FPort = '' then
  1014.   begin
  1015.     Application.MessageBox('No Port Specified', 'WINSOCK ERROR', mb_OKCancel +
  1016.       mb_DefButton1);
  1017.     exit;
  1018.   end;
  1019.   if FIPAddr = '' then
  1020.   begin
  1021.     Application.MessageBox('No IP Address Specified', 'WINSOCK ERROR', mb_OKCancel +
  1022.       mb_DefButton1);
  1023.     exit;
  1024.   end;
  1025.   sin.sin_family := AF_INET;
  1026.   StrPCopy(szPort,FPort);
  1027.   szTcp := 'tcp';
  1028.   Pse := getservbyname(szPort,szTcp);
  1029.   if Pse = nil then
  1030.      sin.sin_port := htons(StrToInt(StrPas(szPort)))
  1031.   else sin.sin_port := Pse^.s_port;
  1032.   StrPCopy(szData,FIPAddr);
  1033.   sin.sin_addr.s_addr := inet_addr(szData);
  1034.   if sin.sin_addr.s_addr = INADDR_NONE then
  1035.     begin
  1036.       Phe := gethostbyname(szData);
  1037.       if Phe = nil then
  1038.         begin
  1039.           StrPCopy(szData,'Cannot convert host address');
  1040.           Application.MessageBox(szData, 'WINSOCK ERROR', mb_OKCancel +
  1041.              mb_DefButton1);
  1042.           exit;
  1043.         end;
  1044.       sin.sin_addr := Phe^.h_addr^^;
  1045.     end;
  1046.   Ppe := getprotobyname(szTcp);
  1047.   FSocket := socket(PF_INET,SOCK_STREAM,Ppe^.p_proto);
  1048.   if FSocket < 0 then
  1049.     SocketError('SConnect (socket)');
  1050.   if FMode = 1 then
  1051.   begin
  1052.     iStatus := WSAASyncSelect(FSocket,Handle,WM_ASYNCSELECT,
  1053.       FD_READ or FD_CLOSE or FD_CONNECT);
  1054.     if iStatus <> 0 then
  1055.       SocketError('WSAAsyncSelect');
  1056.   end
  1057.   else
  1058.     iStatus := ioctlsocket(FSocket,FIONBIO,FMode);
  1059.   if FMode = 0 then
  1060.     SetTimeout;
  1061.   iStatus := connect(FSocket,sin,sizeof(sin));
  1062.   if FMode = 0 then
  1063.     ResetTimeout;
  1064.   if iStatus <> 0 then
  1065.     begin
  1066.     iStatus := WSAGetLastError;
  1067.     if iStatus <> WSAEWOULDBLOCK then
  1068.        SocketError('SConnect');
  1069.     end;
  1070. end;
  1071.  
  1072. procedure TSockets.SListen;
  1073. var
  1074.   iStatus: integer;
  1075.   szTcp: PChar;
  1076.   szPort: array[0..31] of char;
  1077.   szData: array[0..256] of char;
  1078. begin
  1079.   if FPort = '' then
  1080.   begin
  1081.     Application.MessageBox('No Port Specified', 'WINSOCK ERROR', mb_OKCancel +
  1082.       mb_DefButton1);
  1083.     exit;
  1084.   end;
  1085.   sin.sin_family := AF_INET;
  1086.   sin.sin_addr.s_addr := INADDR_ANY;
  1087.   szTcp := 'tcp';
  1088.   StrPCopy(szPort,FPort);
  1089.   Pse := getservbyname(szPort,szTcp);
  1090.   if Pse = nil then
  1091.      sin.sin_port := htons(StrToInt(StrPas(szPort)))
  1092.   else sin.sin_port := Pse^.s_port;
  1093.   Ppe := getprotobyname(szTcp);
  1094.   FMSocket := socket(PF_INET,SOCK_STREAM,Ppe^.p_proto);
  1095.   if FMSocket < 0 then
  1096.     SocketError('socket');
  1097.   iStatus := bind(FMSocket, sin, sizeof(sin));
  1098.   if iStatus <> 0 then
  1099.     SocketError('Bind');
  1100.   iStatus := listen(FMSocket,5);
  1101.   if iStatus <> 0 then
  1102.     SocketError('Listen');
  1103.   if FMode = 1 then
  1104.   begin
  1105.     iStatus := WSAASyncSelect(FMSocket,Handle,WM_ASYNCSELECT,
  1106.       FD_READ or FD_ACCEPT or FD_CLOSE);
  1107.     if iStatus <> 0 then
  1108.       SocketError('WSAASyncSelect');
  1109.   end
  1110.   else ioctlsocket(FMSocket,FIONBIO,FMode);
  1111. end;
  1112.  
  1113. procedure TSockets.SCancelListen;
  1114. var
  1115.   iStatus: integer;
  1116. begin
  1117.   if FMode = 1 then
  1118.     WSAASyncSelect(FMSocket,Handle,WM_ASYNCSELECT,0);
  1119.   shutdown(FMSocket,2);
  1120.   iStatus := closesocket(FMSocket);
  1121.   if iStatus <> 0 then
  1122.     SocketError('CancelListen (closesocket)');
  1123.   FMSocket := 0;
  1124. end;
  1125.  
  1126.  
  1127. function TSockets.SAccept: TSocket;
  1128. var
  1129.   iStatus: integer;
  1130.   len: integer;
  1131. begin
  1132.   len := sizeof(sin);
  1133.   if FMode = 0 then
  1134.     SetTimeout;
  1135.   FSocket := accept(FMSocket,sin,len);
  1136.   if FMode = 0 then
  1137.   begin
  1138.     ResetTimeout;
  1139.     ioctlsocket(FSocket,FIONBIO,FMode);
  1140.   end;
  1141.   if FMSocket < 0 then
  1142.     SocketError('Accept');
  1143.   Result := FSocket;
  1144. end;
  1145.  
  1146. procedure TSockets.SClose;
  1147. var
  1148.   iStatus: integer;
  1149.   lin: linger;
  1150.   linx: array[0..3] of char absolute lin;
  1151. begin
  1152.   if FMode = 1 then
  1153.     WSAASyncSelect(FSocket,Handle,WM_ASYNCSELECT,0);
  1154.   if WSAIsBlocking then
  1155.     WSACancelBlockingCall;
  1156.   shutdown(FSocket,2);
  1157.   lin.l_onoff := 1;
  1158.   lin.l_linger := 0;
  1159.   setsockopt(FSocket,SOL_SOCKET,SO_LINGER,linx,sizeof(lin));
  1160.   iStatus := closesocket(FSocket);
  1161.   if iStatus <> 0 then
  1162.     SocketError('Disconnect (closesocket)');
  1163.   FSocket := INVALID_SOCKET;
  1164. end;
  1165.  
  1166.  
  1167. procedure TSockets.SocketError(sockfunc: string);
  1168. var
  1169.   szLine: array[0..255]  of char;
  1170.   error: integer;
  1171.   line, ErrMsg: string;
  1172. begin
  1173.   error := WSAGetLastError;
  1174.   ErrMsg := SocketErrorDesc(error);
  1175.   line := 'Error '+ IntToStr(error) + ' in function ' + sockfunc +
  1176.   #13#10 + ErrMsg;
  1177.   if Assigned(FErrorOccurred) then
  1178.     FErrorOccurred(Self,error,ErrMsg)
  1179.   else
  1180.     begin
  1181.       StrPCopy(szLine,line);
  1182.       Application.MessageBox(szLine, 'WINSOCK ERROR', mb_OKCancel +
  1183.         mb_DefButton1);
  1184.       halt;
  1185.     end;
  1186. end;
  1187.  
  1188. function TSockets.SocketErrorDesc(error: integer) : string;
  1189. begin
  1190.   case error of
  1191.     WSAEINTR:
  1192.       SocketErrorDesc := 'Interrupted system call';
  1193.     WSAEBADF:
  1194.       SocketErrorDesc := 'Bad file number';
  1195.     WSAEACCES:
  1196.       SocketErrorDesc := 'Permission denied';
  1197.     WSAEFAULT:
  1198.       SocketErrorDesc := 'Bad address';
  1199.     WSAEINVAL:
  1200.       SocketErrorDesc := 'Invalid argument';
  1201.     WSAEMFILE:
  1202.       SocketErrorDesc := 'Too many open files';
  1203.     WSAEWOULDBLOCK:
  1204.       SocketErrorDesc := 'Operation would block';
  1205.     WSAEINPROGRESS:
  1206.       SocketErrorDesc := 'Operation now in progress';
  1207.     WSAEALREADY:
  1208.       SocketErrorDesc := 'Operation already in progress';
  1209.     WSAENOTSOCK:
  1210.       SocketErrorDesc := 'Socket operation on non-socket';
  1211.     WSAEDESTADDRREQ:
  1212.       SocketErrorDesc := 'Destination address required';
  1213.     WSAEMSGSIZE:
  1214.       SocketErrorDesc := 'Message too long';
  1215.     WSAEPROTOTYPE:
  1216.       SocketErrorDesc := 'Protocol wrong type for socket';
  1217.     WSAENOPROTOOPT:
  1218.       SocketErrorDesc := 'Protocol not available';
  1219.     WSAEPROTONOSUPPORT:
  1220.       SocketErrorDesc := 'Protocol not supported';
  1221.     WSAESOCKTNOSUPPORT:
  1222.       SocketErrorDesc := 'Socket type not supported';
  1223.     WSAEOPNOTSUPP:
  1224.       SocketErrorDesc := 'Operation not supported on socket';
  1225.     WSAEPFNOSUPPORT:
  1226.       SocketErrorDesc := 'Protocol family not supported';
  1227.     WSAEAFNOSUPPORT:
  1228.       SocketErrorDesc := 'Address family not supported by protocol family';
  1229.     WSAEADDRINUSE:
  1230.       SocketErrorDesc := 'Address already in use';
  1231.     WSAEADDRNOTAVAIL:
  1232.       SocketErrorDesc := 'Can''t assign requested address';
  1233.     WSAENETDOWN:
  1234.       SocketErrorDesc := 'Network is down';
  1235.     WSAENETUNREACH:
  1236.       SocketErrorDesc := 'Network is unreachable';
  1237.     WSAENETRESET:
  1238.       SocketErrorDesc := 'Network dropped connection on reset';
  1239.     WSAECONNABORTED:
  1240.       SocketErrorDesc := 'Software caused connection abort';
  1241.     WSAECONNRESET:
  1242.       SocketErrorDesc := 'Connection reset by peer';
  1243.     WSAENOBUFS:
  1244.       SocketErrorDesc := 'No buffer space available';
  1245.     WSAEISCONN:
  1246.       SocketErrorDesc := 'Socket is already connected';
  1247.     WSAENOTCONN:
  1248.       SocketErrorDesc := 'Socket is not connected';
  1249.     WSAESHUTDOWN:
  1250.       SocketErrorDesc := 'Can''t send after socket shutdown';
  1251.     WSAETOOMANYREFS:
  1252.       SocketErrorDesc := 'Too many references: can''t splice';
  1253.     WSAETIMEDOUT:
  1254.       SocketErrorDesc := 'Connection timed out';
  1255.     WSAECONNREFUSED:
  1256.       SocketErrorDesc := 'Connection refused';
  1257.     WSAELOOP:
  1258.       SocketErrorDesc := 'Too many levels of symbolic links';
  1259.     WSAENAMETOOLONG:
  1260.       SocketErrorDesc := 'File name too long';
  1261.     WSAEHOSTDOWN:
  1262.       SocketErrorDesc := 'Host is down';
  1263.     WSAEHOSTUNREACH:
  1264.       SocketErrorDesc := 'No route to host';
  1265.     WSAENOTEMPTY:
  1266.       SocketErrorDesc := 'Directory not empty';
  1267.     WSAEPROCLIM:
  1268.       SocketErrorDesc := 'Too many processes';
  1269.     WSAEUSERS:
  1270.       SocketErrorDesc := 'Too many users';
  1271.     WSAEDQUOT:
  1272.       SocketErrorDesc := 'Disc quota exceeded';
  1273.     WSAESTALE:
  1274.       SocketErrorDesc := 'Stale NFS file handle';
  1275.     WSAEREMOTE:
  1276.       SocketErrorDesc := 'Too many levels of remote in path';
  1277.     WSASYSNOTREADY:
  1278.       SocketErrorDesc := 'Network sub-system is unusable';
  1279.     WSAVERNOTSUPPORTED:
  1280.       SocketErrorDesc := 'WinSock DLL cannot support this application';
  1281.     WSANOTINITIALISED:
  1282.       SocketErrorDesc := 'WinSock not initialized';
  1283.     WSAHOST_NOT_FOUND:
  1284.       SocketErrorDesc := 'Host not found';
  1285.     WSATRY_AGAIN:
  1286.       SocketErrorDesc := 'Non-authoritative host not found';
  1287.     WSANO_RECOVERY:
  1288.       SocketErrorDesc := 'Non-recoverable error';
  1289.     WSANO_DATA:
  1290.       SocketErrorDesc := 'No Data';
  1291.     else SocketErrorDesc := 'Not a WinSock error';
  1292.   end;
  1293. end;
  1294.  
  1295. procedure TSockets.SetTimeout;
  1296. begin
  1297.   if FTimeout > 0 then
  1298.     SetTimer(Handle,10,FTimeout*1000,nil);
  1299. end;
  1300.  
  1301. procedure TSockets.ResetTimeout;
  1302. begin
  1303.   if FTimeout > 0 then
  1304.     KillTimer(Handle,10);
  1305. end;
  1306.  
  1307. end.
  1308.